perm filename DDJOB.SAI[DD,BGB] blob
sn#054434 filedate 1973-07-18 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00033 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00004 00002 BEGIN "DDJOB"
00007 00003 α THE LOGICAL WINDOW
00008 00004 PROCEDURE PLOWIN
00009 00005 α SAVE SAIL
00010 00006 PROCEDURE SHOWDD
00011 00007 α SETUP THE COLUMN AND CHANNEL SELECT CONTROL WORDS
00012 00008 PROCEDURE GETDD
00014 00009 PROCEDURE DSKTV (STRING FILE)
00015 00010 α REPACK A SIXBIT TV RASTER INTO ONE BIT RASTERS
00017 00011 α DEPOSIT ACCUMULATORS INTO DD BUFFER AND RE-INIT 'EM
00019 00012 α EXPAND A BIT IMAGE BY 2↑POWER, 1≤POWER≤7.
00021 00013 α INNER LOOPS
00023 00014 α LOOP THRU ALL THE ROWS
00025 00015 α EXPAND THE BYTE BY TABLE LOOKUP
00026 00016 α AT THE END OF A ROW BLIT 2↑P-1 COPIES INTO THE OUTPUT BUFFER
00027 00017 α TABLE OF TABLE POINTER
00031 00018 TABLE4:
00035 00019 α TABLE 4 CONTINUED
00039 00020 TABLE8:
00040 00021 α CONVERT SOURCE AND OBJECT XY WINDOWS INTO CLIPED RC WINDOWS
00043 00022 PROCEDURE XVECTOR (INTEGER VWORD)
00045 00023 α VECTOR EXECUTION CONTINUED
00046 00024 α INNER LOOP OF VECTOR CREATION
00048 00025 INTEGER JBPTR
00050 00026 α PICKUP AN ARC FROM THE J BUFFER
00051 00027 α DIRECTORY OF TV PICTURES ON THE DRUM
00053 00028 α COMMAND #3 - EXECUTE DRUM DD OF A FRAME NUMBER
00055 00029 α COMMAND #1 - EXECUTE DPYDD
00056 00030 PROCEDURE XSHOWDD
00058 00031 α COMMAND #4 - EXECUTE TV UPPER SEGMENT CREATION
00060 00032 START_CODE
00061 00033 α MAIN DDJOB EXECUTION
00063 ENDMK
⊗;
BEGIN "DDJOB"
REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
REQUIRE "DRUMER[SYS,BGB]" SOURCE_FILE;
REQUIRE "SAITRG[SYS,BGB]" SOURCE_FILE;
α ARRAY ALLOCATION;
EXTERNAL PROCEDURE LRMAK (INTEGER LO,HI,ONE);
EXTERNAL INTEGER ARYEL;
DEFINE GETARY(ARRY,SIZE) =
"BEGIN LRMAK(1,SIZE,1); QUICK_CODE MOVEM 1,ARRY;END;END";
DEFINE RELARY(ARRY) =
"QUICK_CODE PUSH 15,ARRY;PUSHJ 15,ARYEL;END";
INTEGER TVPTR;
DEFINE MAIL="'710000000000";
α THE LETTER; SAFE SHORT INTEGER ARRAY LETTER[0:31];
DEFINE
HISJOB = "LETTER[0]",
FILENAME="LETTER[1]",EXTENSION="LETTER[2]",PPNAME="LETTER[3]",
LEVWRD = "LETTER[4]",
JADDR = "LETTER[5]",
LEVCHN = "LETTER[6]",
SX="LETTER[7]",SY="LETTER[8]",SDX="LETTER[9]",SDY="LETTER[10]",
OX="LETTER[11]",OY="LETTER[12]",MAGPOW="LETTER[13]",
FRAME# = "LETTER[14]",
SEGNAME = "LETTER[15]",
ILX="LETTER[16]",ILY="LETTER[17]",ILDX="LETTER[18]",ILDY="LETTER[19]",
DR="LETTER[20]",DC="LETTER[21]",DM="LETTER[22]",DN="LETTER[23]",
VCNT = "LETTER[24]",
ACNT = "LETTER[25]",
COMMAND = "LETTER[31]";
α COMMAND 1 DPYDD;
α COMMAND 2 SHOWDD;
α COMMAND 3 DRUMDD;
α COMMAND 4 TVSEG;
α PHYSICAL WINDOW FRAMES;
DEFINE TVM="216", TVN="288";
DEFINE DDR="0", DDC="0";
DEFINE DDM="480", DDN="512";
DEFINE DDR2="479",DDC2="511";
α THE LOGICAL WINDOW;
REAL LX,LY,LDX,LDY;
α CHANNEL MAP;
PRELOAD_WITH 0,'37,'35,'34,'33,'32,'36,'30;
INTEGER ARRAY DDCHAN[0:16];
α RC SOURCE WINDOW;
SHORT INTEGER SR,SC,SM,SN;
α DESTINATION WINDOW;
SHORT INTEGER DR2,DC2;
INTEGER MAGNIF;
α BUFFERS AND BUFFER DIMENSIONS;
BEGIN
SAFE INTEGER ARRAY TVBUF,BIBUF,DDBUF[1:2];
INTEGER BIWWID,BISIZE,DDWWID,FLDSIZ,DDSIZE;
PROCEDURE PLOWIN;
BEGIN "PLOWIN"
INTEGER ROW,MROWS,NCOLS;
INTEGER DELTA2,DELTA3;
α DDBUF DESTINATION WINDOW;
ROW ← 0;
α BIBUF SOURCE WINDOW;
DELTA2 ← FLDSIZ - BIWWID;
DELTA3 ← 4*FLDSIZ - DDWWID;
START_CODE "LOOP"
LABEL L1,L2,INPTR,OUTPTR;
DEFINE CCNT="0",TMP="1",RCNT="2";
INTEGER TMP16,TMP17;
α INIT ADDRESSES IN INNER LOOP;
MOVE BIBUF;
HRRM INPTR;
MOVE DDBUF;
ADDI 2;
HRRM OUTPTR;
α SAVE SAIL;
MOVEM '16,TMP16;
MOVEM '17,TMP17;
α PICKUP THE INNER LOOP;
HRLZI L1;
HRRI 3;
BLT '16;
α INIT THE INNER LOOP;
MOVE RCNT, DM;
HRR 3, BIWWID;
HRR '12, DELTA2;
HRR '14, DELTA3;
α ENTER THE INNER LOOP;
JRST 3;
L1: MOVEI CCNT,;
INPTR: MOVE TMP,;
OUTPTR: IORM TMP,;
AOS 4;
AOS 5;
SOJG CCNT, 4;
AOS TMP, ROW;
ADDI 5, 2160; α FLDSIZ - BIWWID;
TRNN TMP, 3;
SUBI 5, 8622; α 4*FLDSIZ - DDWWID;
SOJG RCNT, 3;
JRST L2;
L2: MOVE '16, TMP16;
MOVE '17, TMP17;
END "LOOP";
END "PLOWIN";
PROCEDURE SHOWDD ;
QUICK_CODE "SHOWDD"
INTEGER T1,T2;
MOVE 11,DDSIZE;
MOVEM 11,T2;
MOVE 11,DDBUF;
HRRZM 11,T1;
'715000000000 3,T1;
END "SHOWDD";
α SETUP THE COLUMN AND CHANNEL SELECT CONTROL WORDS;
PROCEDURE SETCHN (INTEGER CHAN);
BEGIN "SETCHN"
INTEGER CHANWD,DCOL,CHANNEL,I;
CHANNEL ← DDCHAN[CHAN LAND 7];
CHANWD ← '002004003324;
DCOL ← DC%8;
DCOL ← (1 MAX DCOL) MIN 64;
DPB(DCOL, POINT(8,CHANWD,15));
DPB(CHANNEL,POINT(8,CHANWD,23));
FOR I←2 STEP DDWWID UNTIL DDSIZE DO
DDBUF[I]← CHANWD;
DDBUF[DDSIZE]←0;
END "SETCHN";
PROCEDURE GETDD;
BEGIN "GETDD"
INTEGER DDROWS,LINEWD,LINE,DDPTR,FPTR,I,J;
α DIMENSIONS OF THE DD BUFFER;
DDWWID ← (DN + 31)%32 + 2;
DDROWS ← (DM + 3)%4;
FLDSIZ ← DDROWS*DDWWID;
DDROWS ← DDROWS*4;
DDSIZE ← 4*FLDSIZ+2;
α ALLOCATE THE DD BUFFER;
GETARY(DDBUF,DDSIZE);
START_CODE
MOVE 1,DDBUF;
MOVEI 2;
MOVEM (1);
HRL 1,1;
AOS 1;
MOVE 2,DDBUF;
ADD 2,DDSIZE;
SOS 2;
BLT 1,(2);
END;
α SETUP THE EXECUTE AND LINE SELECT CONTROL WORDS;
LINEWD ← '0454;
LINE ← (0 MAX DR) MIN 479;
DDPTR ← 1;
FOR I←1 STEP 4 UNTIL DDROWS DO
BEGIN "ROWS"
FPTR ← DDPTR;
FOR J←0 STEP 1 UNTIL 3 DO
BEGIN "FIELDS"
DPB(LINE ,POINT(4,LINEWD,23));
DPB(LINE%16,POINT(5,LINEWD,15));
DDBUF[FPTR]← LINEWD;
LINE ← LINE+1;
FPTR ← FPTR + FLDSIZ;
END "FIELDS";
DDPTR ← DDPTR + DDWWID;
END "ROWS";
α ...AND THE FIRST AND LAST CONTROL WORDS ARE ALITTLE DIFFERENT;
DDBUF[1] ← DDBUF[1] LOR '116000001454;
DDBUF[DDSIZE-1] ← '000004010334;
DDBUF[DDSIZE] ← 0;
END "GETDD";
PROCEDURE DSKTV (STRING FILE);
BEGIN "DSKTV"
INTEGER ARRAY HEADER[0:9];
INTEGER FLG,CHN;
IF ARRINFO(TVBUF,0) < 10 THEN
GETARY(TVBUF,11664);
IF LENGTH(FILE)=0 THEN RETURN;
CHN ← GETCHAN;
OPEN(CHN,"DSK",8,3,0,0,0,0);
LOOKUP(CHN,FILE&".TMP[DAT,BGB]",FLG);
IF FLG THEN RETURN;
ARRYIN(CHN,HEADER[0],10);
ARRYIN(CHN,TVBUF[1],10368);
RELEASE(CHN);
END "DSKTV";
α REPACK A SIXBIT TV RASTER INTO ONE BIT RASTERS;
PROCEDURE REPACK ;
BEGIN "OUTER REPACK"
SAFE INTEGER ARRAY BI[1:11664];
INTEGER MROWS,NCOLS,TVWW,BTWW,AREA;
MROWS ← 216;
NCOLS ← 288;
TVWW ← NCOLS%6;
BTWW ← NCOLS%32 + (IF NCOLS LAND '37 THEN 1 ELSE 0);
AREA ← MROWS*BTWW;
START_CODE "REPACK"
LABEL L1,L2,L3,L4,DACBUF;
LABEL DAP2,DAP3,DAP4,DAP5,DAP6;
DEFINE BIT="0",BYTE="7",BTPTR="8",BCNT="9";
DEFINE WCNT="10",RCNT="11",TVPTR="12";
α ALITTLE OLD FASHION ADDRESS MODIFICATION;
MOVE AREA; HRRM DAP2;
ADD AREA; HRRM DAP3;
ADD AREA; HRRM DAP4;
ADD AREA; HRRM DAP5;
ADD AREA; HRRM DAP6;
α AC INIT;
MOVE ['1000002];SETZ 1,;BLT 6;
HRLZI BIT,'400000;
MOVE BTPTR,BI;
MOVE TVPTR,TVBUF;
MOVE RCNT,MROWS;
α MAIN LOOPS;
L1: MOVE WCNT,TVWW;
L2: MOVEI BCNT,6;
MOVE BYTE,(TVPTR);
AOS TVPTR;
L3: ROT BYTE,6;
TRNE BYTE,'40; IOR 1,BIT; α BRIGHT;
TRNE BYTE,'20; IOR 2,BIT;
TRNE BYTE,8; IOR 3,BIT;
TRNE BYTE,4; IOR 4,BIT;
TRNE BYTE,2; IOR 5,BIT;
TRNE BYTE,1; IOR 6,BIT; α DIM ;
LSH BIT,-1;
CAIN BIT, 8;
JSR DACBUF;
SOJG BCNT,L3; α BYTE COUNTER;
SOJG WCNT,L2; α WORD COUNTER;
α END OF A ROW;
SKIPL BIT;
JSR DACBUF;
SOJG RCNT,L1; α ROW COUNTER;
JRST L4;
α DEPOSIT ACCUMULATORS INTO DD BUFFER AND RE-INIT 'EM;
DACBUF: 0;
MOVEM 1,(BTPTR);
DAP2: MOVEM 2,(BTPTR);
DAP3: MOVEM 3,(BTPTR);
DAP4: MOVEM 4,(BTPTR);
DAP5: MOVEM 5,(BTPTR);
DAP6: MOVEM 6,(BTPTR);
AOS BTPTR;
SETZB 1,2; SETZB 3,4; SETZB 5,6;
HRLZI BIT,'400000;
JRST @DACBUF;
L4:
END "REPACK";
ARRBLT(TVBUF[1],BI[1],11664);
END "OUTER REPACK";
α ZERO MAG POWER EXPAND CASE;
PROCEDURE EXPAN0 (INTEGER LL);
BEGIN "EXPAN0"
INTEGER TVPTR,WWID;
TVPTR ← (SR + LL*216)*9 + SC%32;
WWID ← (DN+31)%32;
START_CODE
LABEL L;
MOVE 1,TVPTR;
ADD 1,TVBUF;
MOVE 2,BIBUF;
MOVE 3,SM;
L: HRLZ 7,1;
HRR 7,2;
ADD 2,WWID;
BLT 7,-1(2);
ADDI 1,9;
SOJG 3,L;
END;
END "EXPAN0";
α EXPAND A BIT IMAGE BY 2↑POWER, 1≤POWER≤7.
POWER FACTOR CONVERSION TABLE SIZE & NAME
1 2 8 bits into halfwords 256 TABLE2
2 4 8 bits into a word. 256 TABLE4
3 8 4 bits into a word. 16 TABLE8
4 16 2 bits into a word. 4 TABL16
5 32 1 bit into a word. 2 TABLE1
6 64 1 bit into 2 words. 2 TABLE1
7 128 1 bit into 4 words. 2 TABLE1;
PROCEDURE EXPAND (INTEGER LEVEL);
BEGIN "EXPAND"
SHORT INTEGER R,C,M,N,WWIN,WWOUT,POWER;
INTEGER BYTCNT,COPIES,OLDPTR,WWDEL,WWSWN;
α CHECK FOR ZERO EXPANSION CASE;
IF MAGPOW=0 THEN BEGIN EXPAN0(ABS(LEVEL)-1);RETURN;END;
α RESTRICT THE POWER RANGE;
POWER ← MAGPOW;
POWER ← (1 MAX POWER) MIN 7;
α GET THE SOURCE WINDOW;
R ← SR + 216*(ABS(LEVEL)-1);
C ← SC;
M ← SM;
N ← SN;
WWIN ← 9;
α COMPUTE WORD WIDTHS OF THE WINDOW AND OUTPUT BUFFER;
WWSWN ← ((C LAND '37)+SN+31)%32;
WWOUT ← (DN + 31)%32;
α INPUT BUFFER POINTER'S ROW DELTA;
WWDEL ← WWIN - WWSWN;
α THE NUMBER OF OUTPUT ROWS THAT ARE FORMED BY BLITING;
COPIES ← (1 LSH POWER) - 1;
α INNER LOOPS;
START_CODE "INNER"
α ACCUMULATORS;
DEFINE BYTE="1", WORD="2", INPTR="3";
DEFINE OUTPTR="4", RCNT="5", CCNT="6";
DEFINE TMP="7", BRI="8", SIZ="9";
DEFINE POW="10", MASK="11";
α LABELS;
LABEL NEWROW,BYTE1,BRINIT,NEWCOL,NEWBYT,GETBYT;
LABEL TABPTR,RHALF,FULWRD,WRDCNT,EOR,EOR2;
LABEL TABTAB,TABLE1,TABLE2,TABLE4,TABLE8,TABL16;
LABEL BYTSIZ,CMASK,EOL,OP1,OP2;
α IORM'S OR MOVEM'S;
MOVE ['436004202004];
SKIPL LEVEL;
MOVSS;
HLLZM OP1;
HLLZM OP2;
α INPUT POINTER;
MOVE C;
LSH -5;
MOVE INPTR, R;
IMUL INPTR, WWIN;
ADD INPTR, ;
ADD INPTR, TVBUF;
α OUTPUT POINTER;
MOVE OUTPTR, BIBUF;
MOVEM OUTPTR, OLDPTR;
α INIT POW AND SIZ ACCUMULATORS;
MOVE POW, POWER;
MOVE SIZ, BYTSIZ(POW);
α FIND THE NUMBER OF THE FIRST BIT OF THE FIRST BYTE OF A ROW;
MOVE C;
AND CMASK(POW);
HRRM BYTE1;
α BITS REMAINING IN THE FIRST WORD;
MOVNS;
ADDI 32;
HRRM BRINIT;
α INIT THE EXPANSION TABLE POINTER;
MOVE TABTAB(POW);
HRRM TABPTR;
α LOOP THRU ALL THE ROWS;
MOVE RCNT, M;
NEWROW: MOVE CCNT, N; α COLUMNS REMAINING IN THE ROW;
α GET AND POSITION THE FIRST WORD OF THE ROW;
MOVE WORD, (INPTR);
AOS INPTR;
BYTE1: ROT WORD, ;
α LOOP THRU ALL THE COLUMNS - SIZ COLUMNS PER ITERATION;
BRINIT: MOVEI BRI, ; α BITS REMAINING IN FIRST WORD;
NEWCOL: JUMPLE CCNT, EOR; α END OF A ROW;
α GET A WORD WHEN NECESSARY;
JUMPN BRI, NEWBYT;
MOVE WORD, (INPTR);
AOS INPTR;
MOVEI BRI, 32;
CAMLE BRI, CCNT; α AVOID ROW OVERFLOW;
MOVE BRI, CCNT;
α GET A BYTE OF COLUMNS;
NEWBYT: SETZ BYTE, ;
CAMG SIZ, CCNT;
JRST GETBYT;
α RIGHT SIDE CLIPPING;
ROTC BYTE, (CCNT);
SETZ WORD,;
MOVNS CCNT;
ROTC BYTE, (CCNT);
MOVNS CCNT;
α UNPACK THE BYTE AND UPDATE THE COUNTERS;
GETBYT: ROTC BYTE, (SIZ);
SUB BRI, SIZ;
SUB CCNT, SIZ;
α EXPAND THE BYTE BY TABLE LOOKUP;
TABPTR: MOVE (BYTE);
α OUTPUT THE BYTE;
SKIPE TMP, WRDCNT(POW);
JRST FULWRD;
α HALF WORD OF OUTPUT PER BYTE;
LSH 2;
TLCE OUTPTR, 1;
JRST RHALF;
HRLZ;
OP1: IORM (OUTPTR); α LEFT SIDE;
JRST NEWCOL;
RHALF: LSH 2;
IORI 2;
IORM (OUTPTR); α RIGHT SIDE;
AOS OUTPTR;
JRST NEWCOL;
α OUTPUT BY FULL WORDS;
FULWRD: IORI 2;
OP2: IORM (OUTPTR);
AOS OUTPTR;
SOJG TMP, FULWRD;
JRST NEWCOL;
α OUTPUT WORD COUNT TABLE;
WRDCNT: 0;0;1;1;1;1;2;4;
α AT THE END OF A ROW BLIT 2↑P-1 COPIES INTO THE OUTPUT BUFFER;
EOR: MOVE TMP, COPIES;
EOR2: HRLZ OLDPTR;
HRR OUTPTR;
HRRZM OUTPTR, OLDPTR;
ADD OUTPTR, WWOUT;
BLT -1(OUTPTR);
SOJG TMP, EOR2;
α SAVE THE POINTER;
MOVEM OUTPTR, OLDPTR;
TLZE OUTPTR, 1; α KNOCK OFF POSSIBLE HALFWORD BIT;
AOS OUTPTR;
α BUMP THE INPTR TO THE NEXT ROW;
ADD INPTR, WWDEL;
α DECREM THE ROW COUNT;
SOJG RCNT, NEWROW;
JRST EOL;
α TABLE OF TABLE POINTER;
TABTAB: 0;TABLE2;TABLE4;TABLE8;TABL16;TABLE1;TABLE1;TABLE1;
TABLE1: 0;'777777777760;
TABLE2:
'000000; '000003; '000014; '000017; '000060; '000063; '000074; '000077;
'000300; '000303; '000314; '000317; '000360; '000363; '000374; '000377;
'001400; '001403; '001414; '001417; '001460; '001463; '001474; '001477;
'001700; '001703; '001714; '001717; '001760; '001763; '001774; '001777;
'006000; '006003; '006014; '006017; '006060; '006063; '006074; '006077;
'006300; '006303; '006314; '006317; '006360; '006363; '006374; '006377;
'007400; '007403; '007414; '007417; '007460; '007463; '007474; '007477;
'007700; '007703; '007714; '007717; '007760; '007763; '007774; '007777;
'030000; '030003; '030014; '030017; '030060; '030063; '030074; '030077;
'030300; '030303; '030314; '030317; '030360; '030363; '030374; '030377;
'031400; '031403; '031414; '031417; '031460; '031463; '031474; '031477;
'031700; '031703; '031714; '031717; '031760; '031763; '031774; '031777;
'036000; '036003; '036014; '036017; '036060; '036063; '036074; '036077;
'036300; '036303; '036314; '036317; '036360; '036363; '036374; '036377;
'037400; '037403; '037414; '037417; '037460; '037463; '037474; '037477;
'037700; '037703; '037714; '037717; '037760; '037763; '037774; '037777;
'140000; '140003; '140014; '140017; '140060; '140063; '140074; '140077;
'140300; '140303; '140314; '140317; '140360; '140363; '140374; '140377;
'141400; '141403; '141414; '141417; '141460; '141463; '141474; '141477;
'141700; '141703; '141714; '141717; '141760; '141763; '141774; '141777;
'146000; '146003; '146014; '146017; '146060; '146063; '146074; '146077;
'146300; '146303; '146314; '146317; '146360; '146363; '146374; '146377;
'147400; '147403; '147414; '147417; '147460; '147463; '147474; '147477;
'147700; '147703; '147714; '147717; '147760; '147763; '147774; '147777;
'170000; '170003; '170014; '170017; '170060; '170063; '170074; '170077;
'170300; '170303; '170314; '170317; '170360; '170363; '170374; '170377;
'171400; '171403; '171414; '171417; '171460; '171463; '171474; '171477;
'171700; '171703; '171714; '171717; '171760; '171763; '171774; '171777;
'176000; '176003; '176014; '176017; '176060; '176063; '176074; '176077;
'176300; '176303; '176314; '176317; '176360; '176363; '176374; '176377;
'177400; '177403; '177414; '177417; '177460; '177463; '177474; '177477;
'177700; '177703; '177714; '177717; '177760; '177763; '177774; '177777;
TABLE4:
'000000000000; '000000000360; '000000007400; '000000007760;
'000000170000; '000000170360; '000000177400; '000000177760;
'000003600000; '000003600360; '000003607400; '000003607760;
'000003770000; '000003770360; '000003777400; '000003777760;
'000074000000; '000074000360; '000074007400; '000074007760;
'000074170000; '000074170360; '000074177400; '000074177760;
'000077600000; '000077600360; '000077607400; '000077607760;
'000077770000; '000077770360; '000077777400; '000077777760;
'001700000000; '001700000360; '001700007400; '001700007760;
'001700170000; '001700170360; '001700177400; '001700177760;
'001703600000; '001703600360; '001703607400; '001703607760;
'001703770000; '001703770360; '001703777400; '001703777760;
'001774000000; '001774000360; '001774007400; '001774007760;
'001774170000; '001774170360; '001774177400; '001774177760;
'001777600000; '001777600360; '001777607400; '001777607760;
'001777770000; '001777770360; '001777777400; '001777777760;
'036000000000; '036000000360; '036000007400; '036000007760;
'036000170000; '036000170360; '036000177400; '036000177760;
'036003600000; '036003600360; '036003607400; '036003607760;
'036003770000; '036003770360; '036003777400; '036003777760;
'036074000000; '036074000360; '036074007400; '036074007760;
'036074170000; '036074170360; '036074177400; '036074177760;
'036077600000; '036077600360; '036077607400; '036077607760;
'036077770000; '036077770360; '036077777400; '036077777760;
'037700000000; '037700000360; '037700007400; '037700007760;
'037700170000; '037700170360; '037700177400; '037700177760;
'037703600000; '037703600360; '037703607400; '037703607760;
'037703770000; '037703770360; '037703777400; '037703777760;
'037774000000; '037774000360; '037774007400; '037774007760;
'037774170000; '037774170360; '037774177400; '037774177760;
'037777600000; '037777600360; '037777607400; '037777607760;
'037777770000; '037777770360; '037777777400; '037777777760;
α TABLE 4 CONTINUED;
'740000000000; '740000000360; '740000007400; '740000007760;
'740000170000; '740000170360; '740000177400; '740000177760;
'740003600000; '740003600360; '740003607400; '740003607760;
'740003770000; '740003770360; '740003777400; '740003777760;
'740074000000; '740074000360; '740074007400; '740074007760;
'740074170000; '740074170360; '740074177400; '740074177760;
'740077600000; '740077600360; '740077607400; '740077607760;
'740077770000; '740077770360; '740077777400; '740077777760;
'741700000000; '741700000360; '741700007400; '741700007760;
'741700170000; '741700170360; '741700177400; '741700177760;
'741703600000; '741703600360; '741703607400; '741703607760;
'741703770000; '741703770360; '741703777400; '741703777760;
'741774000000; '741774000360; '741774007400; '741774007760;
'741774170000; '741774170360; '741774177400; '741774177760;
'741777600000; '741777600360; '741777607400; '741777607760;
'741777770000; '741777770360; '741777777400; '741777777760;
'776000000000; '776000000360; '776000007400; '776000007760;
'776000170000; '776000170360; '776000177400; '776000177760;
'776003600000; '776003600360; '776003607400; '776003607760;
'776003770000; '776003770360; '776003777400; '776003777760;
'776074000000; '776074000360; '776074007400; '776074007760;
'776074170000; '776074170360; '776074177400; '776074177760;
'776077600000; '776077600360; '776077607400; '776077607760;
'776077770000; '776077770360; '776077777400; '776077777760;
'777700000000; '777700000360; '777700007400; '777700007760;
'777700170000; '777700170360; '777700177400; '777700177760;
'777703600000; '777703600360; '777703607400; '777703607760;
'777703770000; '777703770360; '777703777400; '777703777760;
'777774000000; '777774000360; '777774007400; '777774007760;
'777774170000; '777774170360; '777774177400; '777774177760;
'777777600000; '777777600360; '777777607400; '777777607760;
'777777770000; '777777770360; '777777777400; '777777777760;
TABLE8:
'000000000000; '000000007760; '000003770000; '000003777760;
'001774000000; '001774007760; '001777770000; '001777777760;
'776000000000; '776000007760; '776003770000; '776003777760;
'777774000000; '777774007760; '777777770000; '777777777760;
TABL16:
'000000000000; '000003777760; '777774000000; '777777777760;
BYTSIZ: 0; 8; 8; 4; 2; 1; 1; 1;
CMASK: 0;'30;'30;'34;'36;'37;'37;'37;
α END OF LOOP;
EOL:
END "INNER";
END "EXPAND";
α CONVERT SOURCE AND OBJECT XY WINDOWS INTO CLIPED RC WINDOWS;
PROCEDURE WNCLIP ;
BEGIN "WNCLIP"
INTEGER RL,RH,CL,CH;
INTEGER SXL,SXH,SYL,SYH;
α MAGNIFICATION FROM MAG POWER;
MAGNIF ← (1 LSH MAGPOW);
α CONVERT OBJECT XY TO RC DESTINATION CENTRAL;
DR ← (DDM%2-1) - OY;
DC ← OX + DDN%2;
α CLIP THE SOURCE WINDOW TO FIT THE DESTINATION FRAME;
SXL←SX -(IF (DC-SDX*MAGNIF)<DDC THEN (DC-DDC )%MAGNIF ELSE SDX);
SXH←SX +(IF (DC+SDX*MAGNIF)>DDC2 THEN (DDC2-DC)%MAGNIF ELSE SDX-1);
SYH←SY +(IF (DR-SDY*MAGNIF)<DDR THEN (DR-DDR )%MAGNIF ELSE SDY-1);
SYL←SY -(IF (DR+SDY*MAGNIF)>DDR2 THEN (DDR2-DR)%MAGNIF ELSE SDY);
α CONVERT THE SOURCE WINDOW FROM XY TO RC;
RL ← (TVM%2-1) - SYH;
RH ← (TVM%2-1) - SYL;
CL ← SXL + TVN%2;
CH ← SXH + TVN%2;
α CLIP THE RC SOURCE WINDOW TO FIT THE SOURCE FRAME;
RL ← RL MAX 0;
CL ← CL MAX 0;
RH ← RH MIN (TVM-1);
CH ← CH MIN (TVN-1);
α INIT THE RC SOURCE WINDOW;
SR ← RL;
SC ← CL;
SM ← RH - RL +1;
SN ← CH - CL +1;
α RE-INIT THE XY SOURCE WINDOW WHICH IS ALSO THE LOGICAL WINDOW;
SDX ← SN/2;
SDY ← SM/2;
α PHYSICAL DESTINATION WINDOW;
DC ← DDC MAX (DC-SDX*MAGNIF);
DR ← DDR MAX (DR-SDY*MAGNIF);
DR2 ← DDR2 MIN (DR + 2*SDY*MAGNIF-1);
DC2 ← DDC2 MIN (DC + 2*SDX*MAGNIF-1);
DM ← DR2 - DR + 1;
DN ← DC2 - DC + 1;
END "WNCLIP";
PROCEDURE XVECTOR (INTEGER VWORD);
BEGIN "XVECTORS"
INTEGER DELROW,DELCOL,YFLAG,NCNT,BIPTR,BIT0,C0,R0;
INTEGER RR,CC,R1,C1,R2,C2;
PROCEDURE XDOT;
BEGIN "XDOT"
SHORT INTEGER BIPTR,BIT0;
RR ← RR - DR;
CC ← CC - DC;
BIPTR ← RR*BIWWID + CC%32;
BIT0 ← 1 ROT - (1+(CC LAND '37));
α PLACE THE DOT INTO THE BUFFER;
START_CODE
MOVE BIT0;
MOVE 1,BIBUF;
ADD 1,BIPTR;
IORM (1);
END;
END "XDOT";
START_CODE "UNPACK"
LABEL L;
MOVE VWORD;
HLRZ 1,;
HRRZ 2,;
CAME 1, 2;
JRST L;
α CALL DOT;
LSH 1, -9;
MOVEM 1, RR;
ANDI 2, '777;
MOVEM 2, CC;
PUSHJ 15, XDOT;
SUB 15, ['2000002];
JRST @2(15);
α CALL VECTOR;
L: MOVE 1;
LSH -9;
MOVEM R1;
ANDI 1, '777;
MOVEM 1, C1;
MOVE 2;
LSH -9;
MOVEM R2;
ANDI 2, '777;
MOVEM 2, C2;
END "UNPACK";
α VECTOR EXECUTION CONTINUED;
DELROW ← R2-R1;
DELCOL ← C2-C1;
IF DELCOL<0 THEN
BEGIN
C0 ← C2; R0 ← R2; DELCOL←ABS(DELCOL); DELROW←-DELROW;
END ELSE
BEGIN
C0 ← C1; R0 ← R1;
END;
YFLAG ← DELROW;
DELROW ← ABS(DELROW);
NCNT ← DELROW MAX DELCOL;
IF DELROW≥DELCOL THEN
BEGIN
NCNT ← DELROW;
DELROW ← '400000;
DELCOL ← '400000*DELCOL%NCNT;
END ELSE
BEGIN
NCNT ← DELCOL;
DELCOL ← '400000;
DELROW ← '400000*DELROW%NCNT;
END;
R0 ← R0 - DR;
C0 ← C0 - DC;
BIPTR ← R0*BIWWID + C0%32;
BIT0 ← 1 ROT -(1+(C0 LAND '37));
α INNER LOOP OF VECTOR CREATION;
START_CODE "TIGHT"
LABEL L1,L2;
INTEGER TMP16,TMP17;
DEFINE BIT="0",CNT="1",CR="2",DEL="3",PTR="'15";
α SAVE SAIL;
MOVEM '16,TMP16;
MOVEM '17,TMP17;
α LOAD CACHE;
HRLZI L1;
HRRI 4;
BLT '17;
α INIT THE LOOP;
MOVE BIT, BIT0;
MOVE CNT, NCNT;
SETZ CR,;
HRRZ DEL, DELROW;
HRL DEL, DELCOL;
HRR '14, BIWWID;
SKIPGE YFLAG;
TLO '14, '4000;
HRR PTR, BIBUF;
ADD PTR, BIPTR;
α ENTER THE LOOP;
IORM BIT, (PTR);
JRST 4;
L1: ADD CR, DEL;
JUMPGE CR, '13;
TLCA CR, '400000;
ROT BIT, -3;
ROT BIT, -1;
CAIN BIT, 8;
AOJA PTR, 7;
TRZE CR, '400000;
ADDI PTR,;
IORM BIT,;
SOJG CNT, 4;
JRST L2;
L2: MOVE '16, TMP16;
MOVE '17, TMP17;
END "TIGHT";
END "XVECTORS";
INTEGER JBPTR;
PROCEDURE XARC;
BEGIN "XARC"
REAL X,Y,S,C,XX;
REAL KX,KY,KROW,KCOL;
REAL BEAMX,BEAMY;
INTEGER I,N,CNT; REAL L;
PROCEDURE DOT (SHORT REAL X,Y);
BEGIN "DOT"
SHORT INTEGER RR,CC,BIPTR,BIT0;
RR ← KROW - KY*Y;
CC ← KCOL + KX*X;
α AVOID OVERFLOW;
DR2←DR+DM-1;
DC2←DC+DN-1;
IF RR = ((DR MAX RR) MIN DR2)
∧ CC = ((DC MAX CC) MIN DC2)
THEN ELSE RETURN;
RR ← RR - DR;
CC ← CC - DC;
BIPTR ← RR*BIWWID + CC%32;
BIT0 ← 1 ROT - (1+(CC LAND '37));
α PLACE THE DOT INTO THE BUFFER;
START_CODE
MOVE BIT0;
MOVE 1,BIBUF;
ADD 1,BIPTR;
IORM (1);
END;
END "DOT";
α COMPUTE SOURCE TO DESTINATION MAPPING CONSTANTS;
KX ← (DN-1)/(2*LDX);
KY ← (DM-1)/(2*LDY);
KCOL ← DC - KX*(LX-LDX);
KROW ← DR + KY*(LY+LDY);
CNT ← ACNT;
α PICKUP AN ARC FROM THE J BUFFER;
FOR CNT←1 STEP 1 UNTIL ACNT DO
BEGIN "ARC LOOP"
START_CODE
MOVN 1, CNT;
IMULI 1, 6;
ADD 1, JBPTR;
SUBI 1, 1;
MOVE 1001(1); MOVEM X;
MOVE 1002(1); MOVEM Y;
MOVE 1003(1); MOVEM L;
MOVE 1004(1); MOVEM N;
MOVE 1005(1); MOVEM BEAMX;
MOVE 1006(1); MOVEM BEAMY;
END;
S ← SIN(L);
C ← COS(L);
FOR I←0 STEP 1 UNTIL N DO
BEGIN
DOT (X+BEAMX,Y+BEAMY);
XX ← X*C - Y*S;
Y ← Y*C + X*S;
X ← XX;
END;
END "ARC LOOP";
END "XARC";
α DIRECTORY OF TV PICTURES ON THE DRUM;
SAFE INTEGER ARRAY TVNAME [1:100];
SAFE INTEGER ARRAY FBPTRS [1:100];
SAFE INTEGER ARRAY FBFILE [1:100];
SAFE INTEGER ARRAY DDFRAME[1:150];
INTEGER TVLAST;
INTEGER TVNOW;
PROCEDURE XDSKTV;
BEGIN "XDSKTV"
INTEGER CHR,FBPTR,I;
STRING STR,FILE;
IF FILENAME=TVNOW THEN RETURN;
FOR I←1 STEP 1 UNTIL TVLAST DO
IF FILENAME=TVNAME[I] THEN
BEGIN
FBPTR ← FBPTRS[I];
START_CODE MOVE 11,TVBUF;HRRZM 11,TVPTR;END;
DRUMI(TVPTR,FBPTR);
TVNOW ← FILENAME;
RETURN;
END;
α GET FROM THE 2314 DISK;
BREAKSET(1," ","I");
STR ← CVXSTR(FILENAME);
FILE ← SCAN(STR,1,CHR);
DSKTV(FILE);
I←TVLAST←TVLAST + 1;
START_CODE MOVE 11,TVBUF;HRRZM 11,TVPTR;END;
FBPTR ← DRUMA(10368);
DRUMO(TVPTR,FBPTR);
FBFILE[I]← FBPTR;
REPACK;
TVNOW ← FILENAME;
α SAVE ON THE DRUM;
FBPTR ← DRUMA(11664);
DRUMO(TVPTR,FBPTR);
FBPTRS[I]← FBPTR;
TVNAME[I]← FILENAME;
END "XDSKTV";
α COMMAND #3 - EXECUTE DRUM DD OF A FRAME NUMBER;
PROCEDURE XDRUMDD;
BEGIN "XDRUMDD"
INTEGER F,I,FBPTR,ADR;
F←FRAME#;
IF ABS(F)>150 THEN RETURN;
α FLUSH THE LIBRASCOPE;
IF F=0 THEN
BEGIN
FOR I←1 STEP 1 UNTIL 50 DO
IF DDFRAME[I] THEN DRUMR(DDFRAME[I]);
DDFRAME[1]←0;ARRBLT(DDFRAME[2],DDFRAME[1],49);
RETURN;
END;
α OUTPUT TO THE LIBRASCOPE;
IF F<0 THEN
BEGIN
FRAME#←F-1;
F←ABS(F);
IF DDFRAME[F] THEN DRUMR(DDFRAME[F]);
FBPTR ← DRUMA(DDSIZE);
START_CODE MOVE DDBUF;HRRZM ADR;END;
DRUMO(ADR,FBPTR);
DDFRAME[F]← FBPTR;
END ELSE
IF DDFRAME[F]≠0 THEN
BEGIN "DRUMDD IN"
FRAME#←F+1;
FBPTR ← DDFRAME[F];
DDSIZE ← FBPTR LAND '777777;
GETARY(DDBUF,DDSIZE);
START_CODE MOVE DDBUF;HRRZM ADR;END;
DRUMI(ADR,FBPTR);
SHOWDD;
RELARY(DDBUF);
END "DRUMDD IN";
END "XDRUMDD";
α COMMAND #1 - EXECUTE DPYDD;
PROCEDURE XDPYDD;
BEGIN "XDPYDD"
INTEGER M,I;
INTEGER ARRAY CHAN[1:6];
XDSKTV;
QUICK_CODE '701000000000 1,HISJOB END;
WNCLIP;
BIWWID← (DN + 31)%32;
BISIZE← DM * BIWWID;
GETARY(BIBUF,BISIZE);
FOR I←1 STEP 1 UNTIL 6 DO
CHAN[I]←(LEVWRD←(LEVWRD ROT 6))LAND 7;
FOR I←1 STEP 1 UNTIL 6 DO
IF CHAN[I]≠0 THEN
BEGIN
GETDD;
EXPAND(I);
SETCHN(CHAN[I]);
PLOWIN;
IF FRAME# THEN XDRUMDD;
SHOWDD;
RELARY(DDBUF);
END;
RELARY(BIBUF);
END "XDPYDD";
PROCEDURE XSHOWDD;
BEGIN "XSHOWDD"
INTEGER I,JSIZE,LEVEL,CHANEL;
LEVEL ← (ABS(LEVCHN)ROT -3)LAND 7;
IF LEVEL=7 THEN LEVEL←0;
CHANEL ← (ABS(LEVCHN)LAND 7);
IF CHANEL=7 THEN CHANEL←0;
IF LEVEL THEN XDSKTV;
JSIZE← IF ACNT THEN 1000 ELSE VCNT+2;
BEGIN
INTEGER ARRAY JOBBUF[1:JSIZE];
START_CODE "GET J BUF"
LABEL Q,L;
INTEGER ARG1,ARG2,ARG3;
MOVE HISJOB;
MOVEM ARG1;
MOVE JADDR;
MOVEM ARG2;
MOVN JSIZE;
HRLM ARG2;
MOVE JOBBUF;
MOVEM ARG3;
MOVEM JBPTR;
MOVEI ARG1;
'40000000000 Q;
JFCL;
JRST L;
Q: '525742624400;
L:
END "GET J BUF";
BIWWID← (DN + 31)%32;
BISIZE← DM * BIWWID;
GETARY(BIBUF,BISIZE);
IF LEVEL THEN EXPAND(LEVEL);
α GENERATE GRAPHICS FROM THE CONTENTS OF THE JOB READ BUFFER;
FOR I←1 STEP 1 UNTIL VCNT DO XVECTOR (JOBBUF[I]);
IF ACNT≠0 THEN XARC;
α CREATE DD BUFFER FROM BI BUFFER;
GETDD;
PLOWIN;
SETCHN(CHANEL);
IF LEVCHN<0 THEN DPB(1,POINT(1,DDBUF[1],3));
QUICK_CODE '701000000000 1,HISJOB END;
SHOWDD;
IF FRAME# THEN XDRUMDD;
RELARY(DDBUF);
RELARY(BIBUF);
END;
END "XSHOWDD";
α COMMAND #4 - EXECUTE TV UPPER SEGMENT CREATION;
PROCEDURE XTVSEG;
BEGIN "XTVSEG"
INTEGER FBPTR,I,FLG,UPNAME;
α UPPER SEGMENT DEFINITIONS;
DEFINE CALLI = "'047000000000";
DEFINE CORE2 = "'400015";
DEFINE ATTSEG = "'400016";
DEFINE DETSEG = "'400017";
DEFINE SEGSIZ = "'400022";
DEFINE SETNM2 = "'400036";
DEFINE NAMEIN = "'400043";
DEFINE SAISG2 = "'634151634722";
α KILL UPPER SEGMENT AND RETURN;
UPNAME ← SEGNAME;
IF FILENAME=0 THEN
START_CODE "KILLUP"
SETZ 1,;
CALLI DETSEG;
MOVE UPNAME;
CALLI ATTSEG; JFCL;
CALLI 1, CORE2; JFCL;
MOVE [SAISG2];
CALLI ATTSEG; JFCL;
POPJ 15,
END "KILLUP";
XDSKTV;
FOR I←1 STEP 1 UNTIL TVLAST DO
IF FILENAME=TVNAME[I] THEN
BEGIN
FBPTR ← FBFILE[I];
QUICK_CODE MOVE 11,TVBUF;HRRZM 11,TVPTR;END;
DRUMI(TVPTR,FBPTR);
TVNOW ← 0;
BEGIN "FILEUP"
START_CODE
MOVE 1, [10400];
CALLI DETSEG;
MOVE UPNAME;
CALLI ATTSEG;
SKIPA;
SKIPA;
CALLI 1, CORE2;
JFCL;
HRLZ TVBUF;
HRRI '400001;
BLT '424201;
MOVE UPNAME;
CALLI SETNM2;
JFCL;
CALLI 1, DETSEG;
MOVE [SAISG2];
CALLI ATTSEG;
JFCL;
END;
END "FILEUP";
END;
END "XTVSEG";
α MAIN DDJOB EXECUTION;
WHILE TRUE DO
BEGIN "FOREVER"
CASE COMMAND OF
BEGIN
IF HISJOB THEN ELSE OUTCHR("*");
XDPYDD;
XSHOWDD;
XDRUMDD;
XTVSEG;
END;
α RETURN RESULTS LETTER TO THE CALLER;
START_CODE "RETURN"
INTEGER CALLER,LTRPTR;
LABEL L;
SKIPN 1, HISJOB;
JRST L;
MOVEM 1, CALLER;
MOVE LETTER;
MOVEM LTRPTR;
MAIL CALLER;
JFCL;
L:
END "RETURN";
α WAIT FOR A COMAND LETTER;
START_CODE "WAITING"
LABEL L;
MOVE 1,LETTER;
HRRM 1,L;
L: MAIL 1,;
MOVE 16(1); MOVEM LX;
MOVE 17(1); MOVEM LY;
MOVE 18(1); MOVEM LDX;
MOVE 19(1); MOVEM LDY;
END "WAITING";
END "FOREVER";
END;
END "DDJOB";